home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 October / EnigmA AMIGA RUN 01 (1995)(G.R. Edizioni)(IT)[!][issue 1995-10][Aminet 7].iso / Aminet / dev / m2 / ModGen.lha / ModGen / Source / ModGen.mod < prev    next >
Text File  |  1995-04-17  |  35KB  |  837 lines
  1. (*---------------------------------------------------------------------------
  2.   :Program.    ModGen
  3.   :Contents.   Modula-2 SourceCode Generator für GadgetToolsBox 2.x
  4.   :Author.     Frank Lömker
  5.   :Copyright.  FreeWare
  6.   :Language.   Modula-2
  7.   :Translator. Turbo Modula-2 V1.40
  8.   :Imports.    GadToolsBox, NoFragLib [Jan van den Baard]
  9.   :Imports.    MGTools, MGRequest [Frank]
  10.   :History.    1.0 [Frank] 17-Apr-95
  11.   :History.        ModGen basiert direkt auf OG V37.11 von Thomas Igracki
  12.   :History.        und GenOberon V1.0 von Kai Bolay und Jan van den Baard.
  13.   :Bugs.       keine bekannt
  14. ---------------------------------------------------------------------------*)
  15.  
  16. MODULE ModGen;
  17.  
  18. FROM SYSTEM IMPORT ADR,ADDRESS,CAST,LONGSET,STRING;
  19. FROM M2Lib IMPORT wbStarted;
  20. IMPORT
  21.    I:=Intuition, G:=Graphics,
  22.    d:=Dos, u:=Utility, df:=DiskFont,
  23.    gtx:=GadToolsBox, nf:=NoFragLib, st:=String,
  24.    mt:=MGTools;
  25. FROM MGTools IMPORT file,fdef,GuiData,MainConfig,FPrintF,FPrintF2,FPrintF3,
  26.       FPrintF4,FPrintF5,FPutS,FPutS2;
  27. FROM MGRequest IMPORT geladen,chain,ValidBits, Request,OpenReq,InitReq,
  28.       OpenSafe,startSave,saveicon;
  29.  
  30. TYPE str43=ARRAY [0..43] OF CHAR;
  31.  
  32. CONST tmp = "NAME,TO=AS,SCREEN,OPENFONT/S,SYSFONT/S,RASTER/S,UNDERMOUSE/S,PORT/S,ICON/S,NOGUI/S,OPT/K";
  33.  
  34. VAR Path : ARRAY [0..511] OF CHAR;
  35.     RD   : d.RDArgsPtr;
  36.     VERSION:str43;
  37.  
  38. PROCEDURE FPfile (str:STRING);
  39. BEGIN
  40.   FPutS (file,str);
  41. END FPfile;
  42.  
  43. (* --- Write the Modula cleanup routine. *)
  44. PROCEDURE WriteCleanup (pw: gtx.ProjectWindowPtr);
  45. BEGIN
  46.   FPrintF (file, ADR("PROCEDURE Close%sWindow;\n"), ADR(pw^.name));
  47.   FPrintF (fdef, ADR("PROCEDURE Close%sWindow;\n"), ADR(pw^.name));
  48.   FPutS (file, "BEGIN\n");
  49.   IF pw^.menus.head^.succ # NIL THEN
  50.     FPrintF3 (file,ADR("  IF %sMenus # NIL THEN\n    IF %sWnd # NIL THEN\n      I.ClearMenuStrip (%sWnd);\n"),
  51.               ADR(pw^.name), ADR(pw^.name), ADR(pw^.name));
  52.     FPrintF2 (file,ADR("    END;\n    gt.FreeMenus (%sMenus);\n    %sMenus := NIL;\n  END;\n"),
  53.               ADR(pw^.name), ADR(pw^.name));
  54.   END;
  55.   FPrintF  (file,ADR("  IF %sWnd # NIL THEN\n"),ADR(pw^.name));
  56.   IF mt.port IN mt.MConfig THEN FPutS (file,"    ");
  57.                            ELSE FPutS (file,"    I."); END;
  58.   FPrintF2 (file,ADR("CloseWindow (%sWnd);\n    %sWnd := NIL;\n  END;\n"),
  59.             ADR(pw^.name), ADR(pw^.name));
  60.   IF pw^.gadgets.head^.succ # NIL THEN
  61.     FPrintF3 (file,ADR("  IF %sGList # NIL THEN\n    gt.FreeGadgets (%sGList);\n    %sGList := NIL;\n  END;\n"),
  62.               ADR(pw^.name), ADR(pw^.name), ADR(pw^.name));
  63.   END;
  64.   IF gtx.FontAdapt IN MainConfig.configFlags0 THEN
  65.     IF mt.SysFont IN mt.MConfig THEN
  66.       FPrintF3 (file,ADR("  IF %sFont # NIL THEN\n    g.CloseFont (%sFont);\n    %sFont := NIL;\n  END;\n"),
  67.                 ADR(pw^.name), ADR(pw^.name), ADR(pw^.name));
  68.     END;
  69.   END;
  70.   IF mt.GetFileInWindow THEN
  71.     FPrintF3 (file,ADR("  IF %sGetImage # NIL THEN\n    C.DisposeObject (%sGetImage);\n    %sGetImage := NIL;\n  END;\n"),
  72.               ADR(pw^.name), ADR(pw^.name), ADR(pw^.name));
  73.   END;
  74.   FPrintF (file, ADR("END Close%sWindow;\n\n"), ADR(pw^.name));
  75. END WriteCleanup;
  76.  
  77. (* --- Write the Screen cleanup routine. *)
  78. PROCEDURE WriteScrCleanup();
  79. BEGIN
  80.   FPutS2 (ADR("PROCEDURE CloseDownScreen;\n"));
  81.   FPutS (file, "BEGIN\n");
  82.   FPutS (file,"  IF VisualInfo # NIL THEN\n    gt.FreeVisualInfo (VisualInfo);\n    VisualInfo := NIL;\n  END;\n");
  83.  
  84.   IF gtx.Custom IN GuiData.flags0 THEN
  85.     FPutS (file,"  IF Scr # NIL THEN\n    I.CloseScreen (Scr);\n    Scr := NIL;\n  END;\n");
  86.   ELSE
  87.     FPutS (file,"  IF Scr # NIL THEN\n    I.UnlockPubScreen (NIL, Scr);\n    Scr := NIL;\n  END;\n");
  88.   END;
  89.  
  90.   IF mt.CheckFont() THEN
  91.     FPutS (file,"  IF Font # NIL THEN\n    g.CloseFont (Font);\n    Font := NIL;\n  END;\n");
  92.   END;
  93.   FPutS (file, "END CloseDownScreen;\n\n");
  94. END WriteScrCleanup;
  95.  
  96. (* --- Write the rendering routine *)
  97. PROCEDURE WriteRender (pw: gtx.ProjectWindowPtr);
  98. VAR box: gtx.BevelBoxPtr;
  99.     i, offx, offy, bleft, btop: INTEGER;
  100.     t: I.IntuiTextPtr;
  101.     alt:G.TextAttrPtr;
  102.     fname: mt.str32;
  103.     str:STRING;
  104.     pos:LONGINT;
  105. BEGIN
  106.   st.strcpy (fname,GuiData.fontName);
  107.   str:=st.strchr(fname,'.'); str^[0]:=0C;
  108.  
  109.   bleft := pw^.leftBorder; btop := pw^.topBorder;
  110.   offx := bleft; offy := btop;
  111.  
  112.   FPrintF (file, ADR("PROCEDURE %sRender;\n"), ADR(pw^.name));
  113.   FPrintF (fdef, ADR("PROCEDURE %sRender;\n"), ADR(pw^.name));
  114.  
  115.   IF ~(gtx.FontAdapt IN MainConfig.configFlags0) THEN FPutS (file, "VAR offx, offy: INTEGER;\n"); END;
  116.   IF (pw^.boxes.head^.succ#NIL) OR (pw^.windowText#NIL) THEN
  117.     IF (gtx.FontAdapt IN MainConfig.configFlags0) THEN
  118.       FPutS (file,"VAR rp:g.RastPortPtr;\n");
  119.     ELSE
  120.       FPutS (file,"    rp:g.RastPortPtr;\n");
  121.     END;
  122.     IF (pw^.boxes.head^.succ#NIL) AND (mt.raster IN mt.MConfig) AND
  123.        (gtx.FontAdapt IN MainConfig.configFlags0) THEN
  124.       FPutS (file,"    sx,sy:INTEGER;\n");
  125.     END;
  126.   END;
  127.   FPutS (file, "BEGIN\n");
  128.  
  129.   IF mt.raster IN mt.MConfig THEN
  130.     FPrintF3 (file,ADR(" IF %sWnd^.Height-%sWnd^.BorderBottom-1-%sWnd^.BorderTop>0 THEN\n"),
  131.                    ADR(pw^.name),ADR(pw^.name),ADR(pw^.name));
  132.     FPrintF (file,ADR("  DrawRast (%sWnd);\n"),ADR(pw^.name));
  133.   END;
  134.  
  135.   IF (pw^.boxes.head^.succ#NIL) OR (pw^.windowText#NIL) THEN
  136.     FPrintF (file, ADR("  rp:=%sWnd^.RPort;\n"), ADR(pw^.name));
  137.   END;
  138.  
  139.   IF ~(gtx.FontAdapt IN MainConfig.configFlags0) THEN
  140.     IF ~(I.BACKDROP <= pw^.windowFlags) THEN
  141.       FPrintF2 (file, ADR("  offx := %sWnd^.BorderLeft;\n  offy := %sWnd^.BorderTop;\n\n"), ADR(pw^.name), ADR(pw^.name));
  142.     ELSE
  143.       FPutS (file, "  offx := 0;\n  offy := Scr^.WBorTop + Scr^.RastPort.TxHeight + 1;\n\n");
  144.     END;
  145.  
  146.     IF pw^.boxes.head^.succ # NIL THEN
  147.       IF mt.raster IN mt.MConfig THEN
  148.         FPutS (file, "  g.SetAPen (rp,0);\n");
  149.         box := pw^.boxes.head;
  150.         WHILE box^.succ # NIL DO
  151.           FPrintF4 (file, ADR("  g.RectFill (rp, offx+(%ld), offy+(%ld), offx+(%ld), offy+(%ld));\n"),
  152.                     box^.left - bleft, box^.top - btop, (box^.left - bleft)+box^.width-1, (box^.top - btop)+box^.height-1);
  153.           box := box^.succ;
  154.         END;
  155.         FPutS (file, "  g.SetAPen (rp,1);\n");
  156.       END;
  157.       box := pw^.boxes.head;
  158.       WHILE box^.succ # NIL DO
  159.         FPrintF4 (file, ADR("  gt.DrawBevelBox (rp, offx+(%ld), offy+(%ld), %ld, %ld,\n"),
  160.                   box^.left - bleft, box^.top - btop, box^.width, box^.height);
  161.         IF gtx.recessed IN box^.flags THEN
  162.           FPutS (file,"                   gt.GT_VisualInfo, VisualInfo, gt.GTBB_Recessed, TRUE,u.TAG_DONE);\n");
  163.         ELSE
  164.           FPutS (file,"                   gt.GT_VisualInfo, VisualInfo, u.TAG_DONE);\n");
  165.         END;
  166.  
  167.         IF gtx.dropBox IN box^.flags THEN
  168.           FPrintF4 (file, ADR("  gt.DrawBevelBox (rp, offx+(%ld), offy+(%ld), %ld, %ld,\n"),
  169.                     box^.left - bleft + 4, box^.top - btop + 2, box^.width- 8, box^.height - 4);
  170.           FPutS (file,"                   gt.GT_VisualInfo, VisualInfo, gt.GTBB_Recessed, TRUE,u.TAG_DONE);\n");
  171.         END;
  172.         box := box^.succ;
  173.       END;  (* WHILE box^.succ # NIL *)
  174.     END;  (* IF pw^.boxes.head^.succ # NIL *)
  175.  
  176.     IF pw^.windowText # NIL THEN
  177.       t := pw^.windowText; i := 0;
  178.       FPrintF (file, ADR("\n  %sIText := [\n"), ADR(pw^.name));
  179.       WHILE t # NIL DO
  180.         FPrintF2 (file, ADR("    [%ld, %ld, "), t^.FrontPen, t^.BackPen);
  181.         mt.WriteDrMd (t^.DrawMode);
  182.         FPrintF4 (file, ADR(", %ld, %ld, y.ADR (%s%ld),\n"), t^.LeftEdge - bleft, t^.TopEdge - btop, ADR(fname), GuiData.font.ta_YSize);
  183.  
  184.         IF t^.NextText # NIL THEN
  185.           FPrintF3 (file, ADR('      "%s", y.ADR (%sIText[%ld])],\n'), t^.IText, ADR(pw^.name), i+1);
  186.         ELSE
  187.           FPrintF (file, ADR('      "%s", NIL] ];\n'), t^.IText);
  188.         END;
  189.         t := t^.NextText;
  190.         INC(i);
  191.       END; (* WHILE *)
  192.       FPrintF (file, ADR("  I.PrintIText (rp, y.ADR(%sIText[0]), offx, offy);\n"), ADR(pw^.name));
  193.     END;
  194.   ELSE
  195.     IF (pw^.windowText#NIL) OR (pw^.boxes.head^.succ#NIL) THEN
  196.       FPrintF2 (file, ADR("  ComputeFont (%sWidth, %sHeight);\n\n"), ADR(pw^.name), ADR(pw^.name));
  197.     END;
  198.     IF pw^.boxes.head^.succ # NIL THEN
  199.       IF mt.raster IN mt.MConfig THEN
  200.         FPutS (file, "  g.SetAPen (rp,0);\n");
  201.         box := pw^.boxes.head;
  202.         WHILE box^.succ # NIL DO
  203.           FPrintF2 (file,ADR("  sx:=OffX+ComputeX(%ld); sy:=OffY+ComputeY(%ld);\n"),
  204.                     box^.left-offx, box^.top-offy);
  205.           FPrintF2 (file,ADR("  g.RectFill (rp, sx, sy, sx+ComputeX(%ld)-2, sy+ComputeY(%ld)-2 );\n"),
  206.                     box^.width, box^.height);
  207.           box := box^.succ;
  208.         END;
  209.         FPutS (file, "  g.SetAPen (rp,1);\n");
  210.       END;
  211.       box := pw^.boxes.head;
  212.       WHILE box^.succ # NIL DO
  213.         FPrintF4 (file,ADR("  gt.DrawBevelBox (rp, OffX+ComputeX(%ld), OffY+ComputeY(%ld),\n                       ComputeX(%ld), ComputeY(%ld),\n"),
  214.                   box^.left - offx, box^.top - offy, box^.width, box^.height);
  215.         IF gtx.recessed IN box^.flags THEN
  216.           FPutS (file,"                   gt.GT_VisualInfo, VisualInfo, gt.GTBB_Recessed, TRUE,u.TAG_DONE);\n");
  217.         ELSE
  218.           FPutS (file,"                   gt.GT_VisualInfo, VisualInfo, u.TAG_DONE);\n");
  219.         END;
  220.         IF gtx.dropBox IN box^.flags THEN
  221.           FPrintF4 (file,ADR("  gt.DrawBevelBox(rp, OffX+ComputeX(%ld), OffY+ComputeY(%ld),\n                  ComputeX(%ld), ComputeY(%ld),\n"),
  222.                     box^.left - offx + 4, box^.top - offy + 2, box^.width - 8, box^.height - 4);
  223.           FPutS (file,"                   gt.GT_VisualInfo, VisualInfo, gt.GTBB_Recessed, TRUE,u.TAG_DONE);\n");
  224.         END;
  225.         box := box^.succ;
  226.       END; (* WHILE *)
  227.     END;
  228.     IF pw^.windowText # NIL THEN
  229.       t := pw^.windowText; i := 0;
  230.       FPrintF (file, ADR("\n  %sIText := [\n"), ADR(pw^.name));
  231.       WHILE t # NIL DO
  232.         FPrintF2 (file, ADR("    [%ld, %ld, "), t^.FrontPen, t^.BackPen);
  233.         mt.WriteDrMd (t^.DrawMode);
  234.         FPrintF (file, ADR(",0 ,OffY + ComputeY (%ld) - Font^.ta_YSize DIV 2, Font,\n"),
  235.                  t^.TopEdge + GuiData.font.ta_YSize DIV 2 - btop);
  236.         IF t^.NextText # NIL THEN
  237.           FPrintF3 (file, ADR('      "%s", y.ADR (%sIText[%ld])],\n'), t^.IText, ADR(pw^.name), i+1);
  238.         ELSE
  239.           FPrintF (file, ADR('      "%s", NIL] ];\n'), t^.IText);
  240.         END;
  241.         t := t^.NextText;
  242.         INC(i);
  243.       END; (* WHILE *)
  244.       t := pw^.windowText; i := 0;
  245.       WHILE t # NIL DO
  246.         alt:=t^.ITextFont;
  247.         IF (alt=NIL) OR (alt^.ta_YSize<1) THEN
  248.           t^.ITextFont:=ADR(GuiData.font);
  249.           pos:=I.IntuiTextLength(t);
  250.           t^.ITextFont:=alt;
  251.         ELSE
  252.           pos:=I.IntuiTextLength(t);
  253.         END;
  254.         FPrintF5 (file, ADR("  %sIText[%ld].LeftEdge:= OffX + ComputeX (%ld) - (I.IntuiTextLength (y.ADR(%sIText[%ld])) DIV 2);\n"),
  255.                    ADR(pw^.name), i, t^.LeftEdge + pos DIV 2 - bleft, ADR(pw^.name), i);
  256.         t := t^.NextText; INC(i);
  257.       END; (* WHILE *)
  258.       FPrintF (file, ADR("  I.PrintIText (rp, y.ADR(%sIText[0]), 0, 0);\n"), ADR(pw^.name));
  259.     END;
  260.   END;
  261.  
  262.   IF mt.raster IN mt.MConfig THEN
  263.     FPutS (file, ' END;\n\n');
  264.     IF pw^.gadgets.head^.succ # NIL THEN
  265.       FPrintF2 (file,ADR('  I.RefreshGList (%sGList, %sWnd, NIL, -1);\n'),ADR(pw^.name),ADR(pw^.name));
  266.     END;
  267.     FPrintF (file,ADR('  gt.GT_RefreshWindow (%sWnd, NIL);\n\n'),ADR(pw^.name));
  268.   END;
  269.  
  270.   FPrintF (file, ADR("END %sRender;\n\n"), ADR(pw^.name) );
  271. END WriteRender;
  272.  
  273. (* --- Write the Modula SetupScreen() routine. *)
  274. PROCEDURE WriteSetupScr (scr:BOOLEAN);
  275. VAR fname: mt.str32;
  276.     xsize, ysize: INTEGER;
  277.     rp: G.RastPort;
  278.     tf: G.TextFontPtr;
  279.     str:STRING;
  280. BEGIN
  281.   st.strcpy (fname,GuiData.fontName);
  282.   str:=st.strchr(fname,'.'); str^[0]:=0C;
  283.  
  284.   IF gtx.FontAdapt IN MainConfig.configFlags0 THEN
  285.     tf := G.OpenFont (ADR(GuiData.font));
  286.     IF tf = NIL THEN tf := df.OpenDiskFont (ADR(GuiData.font)) END;
  287.  
  288.     IF tf # NIL THEN
  289.       G.InitRastPort (rp);
  290.       G.SetFont (ADR(rp), tf);
  291.       xsize := G.TextLength (ADR(rp),ADR("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"), 62) DIV 62;
  292.       G.CloseFont (tf);
  293.     ELSE
  294.       xsize := GuiData.font.ta_YSize;
  295.     END;
  296.  
  297.     ysize := GuiData.font.ta_YSize;
  298.     IF scr THEN
  299.       FPutS (fdef,"PROCEDURE ComputeX (value: INTEGER): INTEGER;\nPROCEDURE ComputeY (value: INTEGER): INTEGER;\n");
  300.       FPutS (fdef,"PROCEDURE ComputeFont (width, height: INTEGER);\n");
  301.     END;
  302.     FPfile ("PROCEDURE ComputeX (value: INTEGER): INTEGER;\nBEGIN\n");
  303.     FPrintF2(file, ADR("  RETURN ((FontX * value) + %ld ) DIV %ld;\n"), xsize DIV 2, xsize);
  304.     FPfile ("END ComputeX;\n\nPROCEDURE ComputeY (value: INTEGER): INTEGER;\nBEGIN\n");
  305.     FPrintF2 (file, ADR("  RETURN ((FontY * value)  + %ld ) DIV %ld;\n"), ysize DIV 2, ysize);
  306.     FPfile ("END ComputeY;\n\nPROCEDURE ComputeFont (width, height: INTEGER);\n");
  307.     IF ~(mt.SysFont IN mt.MConfig) THEN
  308.       FPfile ("VAR x:INTEGER;\nBEGIN\n  Font := y.ADR (Attr);\n  Font^.ta_Name := Scr^.RastPort.Font^.tf_Message.mn_Node.ln_Name;\n");
  309.       FPfile ("  FontY := Scr^.RastPort.Font^.tf_YSize;\n  Font^.ta_YSize := FontY;\n  FontX := Scr^.RastPort.Font^.tf_XSize;\n");
  310.       FPfile ('  IF g.FPB_PROPORTIONAL IN Scr^.RastPort.Font^.tf_Flags THEN\n    x:=(g.TextLength (y.ADR(Scr^.RastPort),y.ADR("ABCDHKOP"),8)+7) DIV 8;\n');
  311.       FPfile ("    IF x>=FontX THEN FontX:=x;\n                ELSE FontX:=(FontX+x) DIV 2; END;\n  END;\n\n");
  312.     ELSE
  313.       FPfile ("BEGIN\n  Font := y.ADR (Attr);\n  e.Forbid;\n");
  314.       FPfile ("  Font^.ta_Name := g.GfxBase^.DefaultFont^.tf_Message.mn_Node.ln_Name;\n  FontY := g.GfxBase^.DefaultFont^.tf_YSize;\n");
  315.       FPfile ("  Font^.ta_YSize := FontY;\n  FontX := g.GfxBase^.DefaultFont^.tf_XSize;\n  e.Permit;\n\n" );
  316.     END;
  317. (******        IF ((pw.windowFlags ADR( WFLGBACKDROP) = WFLGBACKDROP THEN
  318.       FPfile ("  OffX := 0;\n");
  319.     ELSE *******)
  320.       FPfile ("  OffX := Scr^.WBorLeft;\n");
  321. (*****        END; *******)
  322.     FPfile ("  OffY := Scr^.RastPort.TxHeight + Scr^.WBorTop + 1;\n\n  IF (width # 0) AND (height # 0) AND\n     (ComputeX (width) + OffX + Scr^.WBorRight > Scr^.Width) OR\n");
  323.     FPfile ('     (ComputeY (height) + OffY + Scr^.WBorBottom > Scr^.Height) THEN\n');
  324.     FPfile ("    Font := y.ADR (Topaz80);\n");
  325.     FPfile ("    FontY := 8; FontX := 8;\n  END;\nEND ComputeFont;\n\n");
  326.   END;
  327.  
  328.   FPutS2 (ADR("PROCEDURE SetupScreen ("));
  329.   IF gtx.Public IN GuiData.flags0 THEN
  330.     FPutS2 (ADR("pub: y.STRING"));
  331.   END;
  332.   FPutS2 (ADR("): INTEGER;\n"));
  333.   FPutS (file,"BEGIN\n");
  334.  
  335.   IF mt.CheckFont() THEN
  336.     FPrintF2 (file, ADR("  Font := df.OpenDiskFont (y.ADR(%s%ld));\n"), ADR(fname), GuiData.font.ta_YSize);
  337.     FPutS (file, "  IF Font = NIL THEN RETURN 3 END;\n");
  338.   END;
  339.  
  340.   IF gtx.Workbench IN GuiData.flags0 THEN FPutS (file, '  Scr := I.LockPubScreen ("Workbench");\n');
  341.   ELSIF gtx.Public IN GuiData.flags0 THEN FPutS (file, "  Scr := I.LockPubScreen (pub);\n");
  342.   ELSIF gtx.Custom IN GuiData.flags0 THEN
  343.     FPutS (file, "  Scr := I.OpenScreenTags (NIL,\n");
  344.     FPrintF (file, ADR("            I.SA_Left,          %ld,\n"), GuiData.left);
  345.     FPrintF (file, ADR("            I.SA_Top,           %ld,\n"), GuiData.top);
  346.     FPrintF (file, ADR("            I.SA_Width,         %ld,\n"), GuiData.width);
  347.     FPrintF (file, ADR("            I.SA_Height,        %ld,\n"), GuiData.height);
  348.     FPrintF (file, ADR("            I.SA_Depth,         %ld,\n"), GuiData.depth);
  349.  
  350.     IF GuiData.colors[0].ColorIndex # -1 THEN
  351.       FPutS (file, "            I.SA_Colors,        y.ADR (ScreenColors[0]),\n");
  352.     END;
  353.  
  354.     IF ~(gtx.FontAdapt IN MainConfig.configFlags0) THEN
  355.       FPrintF2 (file, ADR("            I.SA_Font,          y.ADR (%s%ld),\n"), ADR(fname), GuiData.font.ta_YSize);
  356.     END;
  357.     FPutS (file,"            I.SA_Type,          I.CUSTOMSCREEN,\n            I.SA_DisplayID,     ");
  358.     mt.WriteIDFlags (CAST(LONGSET,GuiData.displayID));
  359.  
  360.     IF gtx.AutoScroll IN GuiData.flags0 THEN
  361.       FPutS (file,"            I.SA_AutoScroll,    TRUE,\n            I.SA_Overscan,      I.OSCAN_TEXT,\n");
  362.     END;
  363.  
  364.     FPutS (file, "            I.SA_Pens,          y.ADR (DriPens[0]),\n");
  365.     IF st.strlen (GuiData.screenTitle) > 0 THEN
  366.       FPrintF (file, ADR('            I.SA_Title,         "%s",\n'), ADR(GuiData.screenTitle));
  367.     END;
  368.     FPutS (file, "            u.TAG_DONE);\n");
  369.   END;
  370.  
  371.   FPutS (file, "  IF Scr = NIL THEN RETURN 1 END;\n\n");
  372.  
  373.   IF gtx.FontAdapt IN MainConfig.configFlags0 THEN
  374.     FPutS (file, "  ComputeFont (0, 0);\n\n");
  375.   END;
  376.  
  377.   FPutS (file,"  VisualInfo := gt.GetVisualInfoA (Scr, NIL);\n  IF VisualInfo = NIL THEN RETURN 2 END;\n\n");
  378.  
  379.   IF mt.GetFilePresent THEN
  380.     FPutS (file, "  IF gf.GetFileClass = NIL THEN RETURN 4 END;\n\n");
  381.   END;
  382.  
  383.   FPutS (file, "  RETURN 0;\nEND SetupScreen;\n\n");
  384. END WriteSetupScr;
  385.  
  386. (* --- Write the Modula Source file. *)
  387. PROCEDURE WriteSource (scr,win:BOOLEAN);
  388. CONST modstart1="MODULE %s;\n\n(*\n *  Source generated with %s\n *  ModGen is based on OG V37.11 by Thomas Igracki\n";
  389.       modstart2=" *  OG is based on GenOberon V1.0 by Kai Bolay & Jan van den Baard\n *\n *  GUI generated with GadToolsBox by Jan van den Baard\n";
  390.       modstart3=" *  GUI designed by : %s\n *)\n\nIMPORT\n  I:=Intuition, ";
  391. VAR pw,help: gtx.ProjectWindowPtr;
  392.     fname, ModuleName,ScreenNam: mt.str32;
  393.     fnm: mt.Pstr256;
  394.     pnum: INTEGER;
  395.     str:STRING;
  396. BEGIN
  397.   st.strcpy(fname,GuiData.fontName);
  398.   str:=st.strchr(fname,'.'); str^[0]:=0C;
  399.  
  400.   IF scr OR win THEN
  401.     st.strcpy (Path,mt.screen);
  402.     fnm := ADDRESS(d.PathPart (ADR(Path)));
  403.     IF fnm # NIL THEN
  404.       IF fnm^[0] = '/' THEN fnm:=mt.Pstr256(ADDRESS(fnm)+1); END;
  405.       str := st.strchr(fnm^, '.');
  406.       IF str#NIL THEN str^[0]:=0C; END;
  407.       IF win THEN st.strcpy(ScreenNam,fnm^);
  408.              ELSE st.strcpy(ModuleName,fnm^); END;
  409.     END;
  410.   END;
  411.  
  412.   IF NOT scr THEN
  413.     st.strcpy(Path,mt.dest);
  414.     (* Get the module name and delete the ".mod" extennsion if present. *)
  415.     fnm := ADDRESS(d.PathPart (ADR(Path)));
  416.     IF fnm # NIL THEN
  417.       IF fnm^[0] = '/' THEN fnm:=mt.Pstr256(ADDRESS(fnm)+1); END;
  418.       str := st.strchr(fnm^, '.');
  419.       IF str#NIL THEN str^[0] := 0C; END;
  420.       st.strcpy(ModuleName,fnm^);
  421.     END;
  422.   END;
  423.   st.strcat (Path,".mod");
  424.   file := OpenSafe (Path);
  425.   IF (file # NIL) AND (file # CAST(d.FileHandlePtr,4)) THEN
  426.    saveicon (Path);
  427.    str:=st.strrchr(Path,"."); str^[0]:=0C;
  428.    st.strcat (Path,".def");
  429.    fdef:=d.Open (ADR(Path), d.MODE_NEWFILE);
  430.    IF fdef#NIL THEN
  431.     saveicon (Path);
  432.     startSave (TRUE);
  433.     d.SetIoErr (0);
  434.     mt.CheckGetFile();  (* GetFile and ListView *)
  435.     IF scr THEN
  436.       help:=mt.Projects.head^.succ; mt.Projects.head^.succ:=NIL;
  437.     END;
  438.     FPutS (file,"IMPLEMENTATION ");
  439.     FPutS (fdef,"DEFINITION ");
  440.  
  441.     FPrintF2 (file,ADR(modstart1),ADR(ModuleName), ADR(VERSION[6]));
  442.     FPutS    (file,modstart2);
  443.     FPrintF  (file,ADR(modstart3), ADR(MainConfig.userName));
  444.     FPrintF2 (fdef,ADR(modstart1),ADR(ModuleName), ADR(VERSION[6]));
  445.     FPutS    (fdef,modstart2);
  446.     FPrintF  (fdef,ADR(modstart3), ADR(MainConfig.userName));
  447.     IF mt.CheckFont() OR (gtx.FontAdapt IN MainConfig.configFlags0) OR
  448.        (NOT (gtx.FontAdapt IN MainConfig.configFlags0) AND scr) THEN
  449.       FPutS (fdef,"g:=Graphics, ");
  450.     END;
  451.     IF scr AND (mt.port IN mt.MConfig) THEN FPutS (fdef,"u:=Utility, "); END;
  452.     FPutS (file, "gt:=GadTools, u:=Utility, g:=Graphics, ");
  453.  
  454.     IF mt.ListViewPresent OR ((gtx.FontAdapt IN MainConfig.configFlags0) AND
  455.        (mt.SysFont IN mt.MConfig)) OR ((scr OR NOT win) AND (mt.port IN mt.MConfig)) THEN
  456.       FPutS (file, "e:=Exec, ");
  457.       IF (scr OR NOT win) AND (mt.port IN mt.MConfig) THEN FPutS (file,"al:=AmigaLib, "); END;
  458.     END;
  459.     IF mt.CheckFont() OR (mt.SysFont IN mt.MConfig) THEN
  460.       FPutS (file, "df:=DiskFont, ");
  461.     END;
  462.     IF gtx.Custom IN GuiData.flags0 THEN FPutS (file, "m:=ModeKeys, "); END;
  463.     pnum:=0;
  464.     pw := mt.Projects.head;
  465.     WHILE (pw^.succ#NIL) AND (pnum=0) DO
  466.       IF pw^.gadgets.head^.succ#NIL THEN pnum:=1; END;
  467.       pw := pw^.succ;
  468.     END;
  469.     IF ((scr OR NOT win) AND (mt.port IN mt.MConfig)) OR (pnum=1) THEN
  470.       FPutS (file, "C:=Classes, ");
  471.     END;
  472.     IF mt.GetFilePresent THEN FPutS (file, "gf:=GetFile, "); END;
  473.     IF mt.raster IN mt.MConfig THEN FPutS (file, "gfx:=GfxMacros, "); END;
  474.     IF scr OR NOT win THEN FPutS (file,"m2:=M2Lib, "); END;
  475.     FPutS2 (ADR("y:=SYSTEM;\n"));
  476.     IF win THEN
  477.       FPrintF (file,ADR("FROM %s IMPORT Scr,VisualInfo,SetupScreen,CloseDownScreen"),ADR(ScreenNam));
  478.       IF mt.CheckFont() THEN FPutS (file,",Font"); END;
  479.       IF gtx.FontAdapt IN MainConfig.configFlags0 THEN
  480.         FPutS (file,",Font,Attr,OffX,OffY,ComputeX,ComputeY,ComputeFont");
  481.       ELSE
  482.         FPrintF2 (file, ADR(",%s%ld"), ADR(fname),GuiData.font.ta_YSize);
  483.       END;
  484.       IF mt.raster IN mt.MConfig THEN
  485.         FPutS (file,",DrawRast");
  486.       END;
  487.       IF mt.port IN mt.MConfig THEN
  488.         FPutS (file,",CloseWindow,OpenWindowTags");
  489.       END;
  490.       FPutS (file,",GetMem;\n");
  491.     END;
  492.     IF NOT scr THEN
  493.       FPutS (fdef,"\nCONST\n");
  494.       FPutS (file,"\n");
  495.       mt.WriteID();
  496.     END;
  497.  
  498.     mt.WriteGlob (scr,win);
  499.     IF NOT scr THEN
  500.       mt.WriteLabels (FALSE);
  501.       IF mt.ListViewPresent THEN mt.WriteList(); END;
  502.     END;
  503.     IF (NOT win) AND  ~(gtx.FontAdapt IN MainConfig.configFlags0) THEN
  504.       mt.WriteTextAttr(scr,FALSE)
  505.     END;
  506.     IF NOT scr THEN
  507.       mt.WriteIText();
  508.       mt.WriteMenus (FALSE);
  509.       mt.WriteGTypes (FALSE);
  510.       mt.WriteGArray (FALSE);
  511.       mt.WriteGTags (FALSE);
  512.     END;
  513.  
  514.     IF NOT win THEN
  515.       IF (gtx.Custom IN GuiData.flags0) THEN
  516.         mt.WriteSTags(FALSE);
  517.       END;
  518.  
  519.       FPutS (file,"\n");
  520.       WriteSetupScr (scr);
  521.       WriteScrCleanup();
  522.  
  523.       IF mt.raster IN mt.MConfig THEN
  524.         IF scr THEN FPutS (fdef,"PROCEDURE DrawRast (win: I.WindowPtr);\n"); END;
  525.         FPfile ("PROCEDURE DrawRast (win: I.WindowPtr);\n");
  526.         FPfile ("TYPE PattType = ARRAY [0..1] OF CARDINAL;\n");
  527.         FPfile ("VAR backPatt : PattType;\n");
  528.         FPfile ("BEGIN\n");
  529.         FPfile ("  backPatt := [0AAAAH,05555H];\n");
  530.         FPfile ("  g.SetAPen (win^.RPort, 2);\n");
  531.         FPfile ("  gfx.SetAfPt (win^.RPort, y.ADR(backPatt),1);\n");
  532.         FPfile ("  IF I.GIMMEZEROZERO <= win^.Flags THEN\n");
  533.         FPfile ("    g.RectFill(win^.RPort,0,0,win^.GZZWidth,win^.GZZHeight);\n");
  534.         FPfile ("  ELSE\n");
  535.         FPfile ("    g.RectFill(win^.RPort, win^.BorderLeft,win^.BorderTop,\n");
  536.         FPfile ("               win^.Width-win^.BorderLeft-1, win^.Height-win^.BorderBottom-1);\n");
  537.         FPfile ("  END;\n");
  538.         FPfile ("  gfx.SetAfPt (win^.RPort, NIL,0);\n");
  539.         FPfile ("END DrawRast;\n\n");
  540.       END;
  541.     ELSE FPutS (file,"\n"); END;
  542.  
  543.     IF (scr OR NOT win) AND (mt.port IN mt.MConfig) THEN
  544.       IF scr THEN
  545.         FPutS (fdef,
  546.           "PROCEDURE CloseWindow (win:I.WindowPtr);\nPROCEDURE OpenWindowTags (nw:I.NewWindowPtr;tag1:LONGINT;..):I.WindowPtr;\n");
  547.       END;
  548.       FPfile ("VAR IdcmpPort:e.MsgPortPtr;\n\n");
  549.       FPfile ("PROCEDURE CloseWindow (win:I.WindowPtr);\n");
  550.       FPfile ("VAR msg,succ:I.IntuiMessagePtr;\n");
  551.       FPfile ("BEGIN\n");
  552.       FPfile ("  e.Forbid;\n");
  553.       FPfile ("  msg:=y.CAST(I.IntuiMessagePtr,win^.UserPort^.mp_MsgList.lh_Head);\n");
  554.       FPfile ("  WHILE msg^.ExecMessage.mn_Node.ln_Succ#NIL DO\n");
  555.       FPfile ("    succ:=y.CAST(I.IntuiMessagePtr,msg^.ExecMessage.mn_Node.ln_Succ);\n");
  556.       FPfile ("    IF msg^.IDCMPWindow=win THEN\n");
  557.       FPfile ("      e.Remove (y.ADDRESS(msg));\n");
  558.       FPfile ("      e.ReplyMsg (msg);\n");
  559.       FPfile ("    END;\n");
  560.       FPfile ("    msg:=succ;\n");
  561.       FPfile ("  END;\n");
  562.       FPfile ("  win^.UserPort:=NIL;\n");
  563.       FPfile ("  I.ModifyIDCMP (win,{});\n");
  564.       FPfile ("  e.Permit;\n");
  565.       FPfile ("  I.CloseWindow (win);\n");
  566.       FPfile ("END CloseWindow;\n\n");
  567.       FPfile ("PROCEDURE OpenWindowTags (nw:I.NewWindowPtr;tag1:LONGINT;..):I.WindowPtr;\n");
  568.       FPfile ("VAR idcmp:LONGCARD;\n");
  569.       FPfile ("    win:I.WindowPtr;\n");
  570.       FPfile ("    buf:ARRAY [0..1] OF LONGINT;\n");
  571.       FPfile ("BEGIN\n");
  572.       FPfile ("  buf:=[I.WA_IDCMP,u.TAG_DONE];\n");
  573.       FPfile ("  idcmp:=u.GetTagData (I.WA_IDCMP,0,y.ADR(tag1));\n");
  574.       FPfile ("  IF (idcmp#0) AND (IdcmpPort=NIL) THEN RETURN NIL;\n");
  575.       FPfile ("  ELSE\n");
  576.       FPfile ("    u.FilterTagItems(y.ADR(tag1),y.ADR(buf),u.TAGFILTER_NOT);\n");
  577.       FPfile ("    win:=I.OpenWindowTagList (nw,y.ADR(tag1));\n");
  578.       FPfile ("    IF (win#NIL) AND (idcmp#0) THEN\n");
  579.       FPfile ("      win^.UserPort:=IdcmpPort;\n");
  580.       FPfile ("      I.ModifyIDCMP (win,LONGSET(idcmp));\n");
  581.       FPfile ("    END;\n");
  582.       FPfile ("    RETURN win;\n");
  583.       FPfile ("  END;\n");
  584.       FPfile ("END OpenWindowTags;\n\n");
  585.     END;
  586.  
  587.     pw := mt.Projects.head; pnum := 0;
  588.     WHILE pw^.succ # NIL DO
  589.       mt.CheckItOut (pw);  (* GETFILE, joined LISTVIEWS ? *)
  590.  
  591.       (* Both texts and boxes are supported with or without font-adapt. *)
  592.  
  593.       IF (pw^.windowText # NIL) OR (pw^.boxes.head^.succ # NIL) OR (mt.raster IN mt.MConfig) THEN
  594.         WriteRender(pw);
  595.       END;
  596.  
  597.       IF pw^.gadgets.head^.succ # NIL THEN
  598.         mt.WriteGadHeader(pw);
  599.  
  600.         mt.WriteNodes (pw, pnum);
  601.  
  602.         IF mt.GetFileInWindow THEN
  603.           FPrintF (file, ADR("  %sGetImage := C.NewObject (gf.GetFileClass,NIL,gt.GT_VisualInfo,VisualInfo,\n"), ADR(pw^.name));
  604.           IF gtx.FontAdapt IN MainConfig.configFlags0 THEN
  605.             FPutS(file,"                                   C.IA_Width,ComputeX(20),C.IA_Height,ComputeY(14),");
  606.           END;
  607.           FPrintF (file, ADR("u.TAG_DONE);\n  IF %sGetImage = NIL THEN RETURN 7 END;\n\n"), ADR(pw^.name));
  608.         END;
  609.  
  610.         FPrintF (file, ADR("  gad := gt.CreateContext (%sGList);\n"), ADR(pw^.name));
  611.         FPutS (file, "  IF gad = NIL THEN RETURN 1 END;\n\n");
  612.  
  613.         mt.WriteGadgets(pw);
  614.  
  615.         FPrintF  (file, ADR("\n  RETURN 0;\nEND Create%sGadgets;\n\n"), ADR(pw^.name));
  616.       END;
  617.  
  618.       mt.WriteHeader(pw);
  619.  
  620.       IF pw^.menus.head^.succ # NIL THEN
  621.         FPrintF2 (file, ADR("  %sMenus := gt.CreateMenus (%sNewMenu^, gt.GTMN_FrontPen, 0, u.TAG_DONE);\n"), ADR(pw^.name), ADR(pw^.name));
  622.         FPrintF (file, ADR("  IF %sMenus = NIL THEN RETURN 3 END;\n\n"), ADR(pw^.name));
  623.         FPrintF (file, ADR("  IF NOT gt.LayoutMenus (%sMenus, VisualInfo, gt.GTMN_NewLookMenus, TRUE, "), ADR(pw^.name));
  624.         IF ~(gtx.FontAdapt IN MainConfig.configFlags0) THEN
  625.           FPrintF2 (file, ADR("gt.GTMN_TextAttr, y.ADR (%s%ld), u.TAG_DONE) THEN RETURN 4 END;\n\n"), ADR(fname), GuiData.font.ta_YSize);
  626.         ELSE
  627.           FPutS (file, "u.TAG_DONE) THEN RETURN 4 END;\n\n");
  628.         END;
  629.       END;
  630.  
  631.       IF ~(I.WINDOWSIZING <= pw^.windowFlags) THEN
  632.         IF gtx.Zoom IN pw^.tagFlags THEN
  633.           FPrintF4 (file, ADR("  %sZoom[0] := %sLeft;\n  %sZoom[1] := %sTop;\n"), ADR(pw^.name), ADR(pw^.name),  ADR(pw^.name), ADR(pw^.name));
  634.         ELSIF gtx.DefaultZoom IN pw^.tagFlags THEN
  635.           FPrintF2 (file, ADR("  %sZoom[0] := 0;\n  %sZoom[1] := 0;\n"), ADR(pw^.name), ADR(pw^.name));
  636.         END;
  637.         IF LONGSET{gtx.Zoom,gtx.DefaultZoom} * pw^.tagFlags # LONGSET{} THEN
  638.           FPrintF3 (file, ADR('  %sZoom[2] := g.TextLength (y.ADR (Scr^.RastPort), y.ADR("%s"), %ld) + 80;\n'), ADR(pw^.name), ADR(pw^.windowTitle[0]), st.strlen (pw^.windowTitle));
  639.           FPrintF (file, ADR("  %sZoom[3] := Scr^.WBorTop + Scr^.RastPort.TxHeight + 1;\n\n"), ADR(pw^.name));
  640.         END;
  641.       END;
  642.  
  643.       mt.WriteWindow(pw);
  644.  
  645.       IF pw^.menus.head^.succ # NIL THEN
  646.         FPrintF2 (file, ADR("  IF NOT I.SetMenuStrip (%sWnd, %sMenus) THEN RETURN 6 END;\n"), ADR(pw^.name), ADR(pw^.name));
  647.       END;
  648.  
  649.       (* Both texts and boxes are supported with or without font-adapt. *)
  650.  
  651.       IF (mt.raster IN mt.MConfig) AND (pw^.gadgets.head^.succ#NIL) THEN
  652.         FPrintF2 (file,ADR("  ret:=I.AddGList (%sWnd,%sGList,-1,-1,NIL);\n"), ADR(pw^.name), ADR(pw^.name));
  653.       END;
  654.       IF (pw^.windowText # NIL) OR (pw^.boxes.head^.succ # NIL) OR (mt.raster IN mt.MConfig) THEN
  655.         FPrintF (file, ADR("  %sRender;\n\n"), ADR(pw^.name));
  656.       END;
  657.       IF NOT (mt.raster IN mt.MConfig) THEN
  658.         FPrintF (file, ADR("  gt.GT_RefreshWindow (%sWnd, NIL);\n\n"), ADR(pw^.name));
  659.       END;
  660.       FPrintF  (file, ADR("  RETURN 0;\nEND Open%sWindow;\n\n"), ADR(pw^.name));
  661.  
  662.       WriteCleanup(pw);
  663.       pw := pw^.succ; INC(pnum);
  664.     END; (* WHILE *)
  665.  
  666.     IF (scr OR NOT win) THEN
  667.       IF scr THEN
  668.         FPutS (fdef,"PROCEDURE GetMem (size:LONGINT):y.ADDRESS;\n");
  669.       END;
  670.       FPfile ("PROCEDURE GetMem (size:LONGINT):y.ADDRESS;\n");
  671.       FPfile ("VAR ptr:y.ADDRESS;\n");
  672.       FPfile ("BEGIN\n");
  673.       FPfile ("  ptr:=m2.malloc (size);\n");
  674.       FPfile ('  IF ptr=NIL THEN m2._ErrorReq ("Not enought Memory"," "); END;\n');
  675.       FPfile ("  RETURN ptr;\n");
  676.       FPfile ("END GetMem;\n\n");
  677.     END;
  678.     IF (scr OR NOT win) AND  ~(gtx.FontAdapt IN MainConfig.configFlags0) THEN
  679.       mt.WriteTextAttr (scr,TRUE);
  680.     ELSE
  681.       FPfile ("BEGIN\n");
  682.     END;
  683.     IF NOT win AND (gtx.FontAdapt IN MainConfig.configFlags0) THEN
  684.       FPfile ('  Topaz80:=[y.ADR ("topaz.font"),8];\n');
  685.     END;
  686.     IF NOT win AND (gtx.Custom IN GuiData.flags0) THEN
  687.       mt.WriteSTags (TRUE);
  688.     END;
  689.     IF win OR NOT scr THEN
  690.       mt.WriteLabels (TRUE);
  691.       IF NOT scr THEN
  692.         mt.WriteMenus (TRUE);
  693.         mt.WriteGTypes (TRUE);
  694.         mt.WriteGArray (TRUE);
  695.         mt.WriteGTags (TRUE);
  696.       END;
  697.       mt.InitCoords;
  698.     END;
  699.     IF (scr OR NOT win) AND (mt.port IN mt.MConfig) THEN
  700.       FPutS (file,'  IdcmpPort:=al.CreatePort (y.ADR(""),0);\n');
  701.       FPfile ("CLOSE\n");
  702.       FPfile ("  IF IdcmpPort#NIL THEN\n");
  703.       FPfile ("    al.DeletePort (IdcmpPort); IdcmpPort:=NIL;\n");
  704.       FPfile ("  END;\n");
  705.     END;
  706.     FPrintF (file, ADR("END %s.\n"), ADR(ModuleName));
  707.     FPrintF (fdef, ADR("\nEND %s.\n"), ADR(ModuleName));
  708.  
  709.     IF scr THEN mt.Projects.head^.succ:=help; END;
  710.     startSave (FALSE);
  711.  
  712.     IF d.IoErr() > 0 THEN Request (ADR("Error: write error"),NIL); END;
  713.     d.Close (fdef); fdef := NIL;
  714.    ELSE
  715.     Request (ADR("Error: unable to open %s"),ADR(Path));
  716.    END;
  717.    d.Close (file); file := NIL;
  718.   ELSIF file=NIL THEN
  719.    Request (ADR("Error: unable to open %s"),ADR(Path));
  720.   ELSE file:=NIL; END;
  721. END WriteSource;
  722.  
  723. VAR ende:BOOLEAN;
  724.     ptr,ptr2:ADDRESS;
  725.     pw: gtx.ProjectWindowPtr;
  726.     start,end:INTEGER;
  727.     error:LONGINT;
  728. BEGIN
  729.   VERSION := '$VER: ModGen V1.0 (17.4.95) by Frank Lömker';
  730.   geladen:=FALSE; mt.source:=""; mt.dest:=""; mt.screen:="";
  731.   mt.MConfig:=LONGSET{}; mt.args.nogui:=d.DOSFALSE;
  732.   chain:=nf.GetMemoryChain(4096);
  733.   IF chain # NIL THEN
  734.     IF NOT wbStarted THEN
  735.       RD := d.ReadArgs (ADR(tmp),ADR(mt.args), NIL);
  736.       IF RD # NIL THEN
  737.         IF (mt.args.nogui=d.DOSTRUE) AND
  738.            ((mt.args.name=NIL) OR (mt.args.baseName=NIL)) THEN
  739.           d.VPrintf(ADR("NOGUI only possible if Source and Dest are given\n"),NIL);
  740.           RETURN 10;
  741.         END;
  742.       ELSE
  743.         IF d.PrintFault (d.IoErr(),ADR("Error")) THEN END; RETURN 10;
  744.       END;
  745.       d.Printf (ADR("%s.\n Based on Thomas Igracki's OG V37.11\n      and Kai Bolay's GenOberon V1.0.\n"),
  746.                 ADR(VERSION[6]) );
  747.       IF mt.args.name#NIL THEN st.strcpy(mt.source,mt.args.name^); END;
  748.       IF mt.args.baseName#NIL THEN st.strcpy(mt.dest,mt.args.baseName^); END;
  749.       IF mt.args.screenPtr#NIL THEN st.strcpy(mt.screen,mt.args.screenPtr^); END;
  750.       IF mt.args.nogui=d.DOSTRUE THEN
  751.         IF mt.args.openfont=d.DOSTRUE THEN INCL (mt.MConfig,mt.GenOpenFont); END;
  752.         IF mt.args.sysfont=d.DOSTRUE THEN INCL (mt.MConfig,mt.SysFont); END;
  753.         IF mt.args.raster=d.DOSTRUE THEN INCL (mt.MConfig,mt.raster); END;
  754.         IF mt.args.mouse=d.DOSTRUE THEN INCL (mt.MConfig,mt.mouse); END;
  755.         IF mt.args.port=d.DOSTRUE THEN INCL (mt.MConfig,mt.port); END;
  756.         IF mt.args.icon=d.DOSTRUE THEN INCL (mt.MConfig,mt.icon); END;
  757.         IF mt.args.opts#NIL THEN
  758.           FOR start:=0 TO st.strlen(mt.args.opts^)-1 DO
  759.             CASE CAP(mt.args.opts^[start]) OF
  760.               "O": INCL (mt.MConfig,mt.GenOpenFont);
  761.              |"S": INCL (mt.MConfig,mt.SysFont);
  762.              |"R": INCL (mt.MConfig,mt.raster);
  763.              |"U": INCL (mt.MConfig,mt.mouse);
  764.              |"P": INCL (mt.MConfig,mt.port);
  765.              |"I": INCL (mt.MConfig,mt.icon);
  766.             ELSE
  767.             END;
  768.           END;
  769.         END;
  770.       END;  (* IF nogui *)
  771.     END;  (* IF NOT wbStarted *)
  772.     IF mt.args.nogui=d.DOSTRUE THEN
  773.       error:=gtx.GTX_LoadGUI (chain,mt.args.name,
  774.                              gtx.rgGUI,ADR(GuiData),
  775.                              gtx.rgConfig,ADR(MainConfig),
  776.                              gtx.rgWindowList,ADR(mt.Projects),
  777.                              gtx.rgValid,ADR(ValidBits), u.TAG_DONE);
  778.       geladen:=TRUE;
  779.       IF error=0 THEN
  780.         WriteSource(FALSE,FALSE);
  781.       ELSE
  782.         CASE error OF
  783.           | gtx.ErrorNoMem:      ptr:=ADR("Error: out of memory\n");
  784.           | gtx.ErrorOpen:       ptr:=ADR("Error: unable to open the GUI file\n");
  785.           | gtx.ErrorRead:       ptr:=ADR("Error: read error\n");
  786.           | gtx.ErrorWrite:      ptr:=ADR("Error: write error\n");
  787.           | gtx.ErrorParse:      ptr:=ADR("Error: iffparse.library error\n");
  788.           | gtx.ErrorPacker:     ptr:=ADR("Error: unable to decrunch the file\n");
  789.           | gtx.ErrorPPLib:      ptr:=ADR("Error: the file is crunched and the powerpacker.library is not available\n");
  790.           | gtx.ErrorNotGUIFile: ptr:=ADR("Error: not a GUI file\n");
  791.         ELSE
  792.           ptr:=ADR("Unknown error\n");
  793.         END;
  794.         d.VPrintf (ptr,NIL);
  795.       END;
  796.     ELSE
  797.       InitReq;
  798.       REPEAT
  799.         ende:=OpenReq(start,end);
  800.         IF NOT ende THEN
  801.           IF start=-1 THEN WriteSource(FALSE,FALSE);
  802.           ELSE
  803.             IF start=0 THEN
  804.               WriteSource(TRUE,FALSE);
  805.               INC (start);
  806.             END;
  807.             IF start<=end THEN
  808.               end:=end-start;
  809.               pw:=mt.Projects.head; ptr:=mt.Projects.head;
  810.               WHILE start>1 DO
  811.                 pw:=pw^.succ; DEC (start);
  812.               END;
  813.               mt.Projects.head:=pw;
  814.               WHILE end>=0 DO
  815.                 pw:=pw^.succ; DEC (end);
  816.               END;
  817.               ptr2:=pw^.succ; pw^.succ:=NIL;
  818.               WriteSource(FALSE,TRUE);
  819.               mt.Projects.head:=ptr; pw^.succ:=ptr2;
  820.             END;
  821.           END;
  822.         END;
  823.       UNTIL ende;
  824.     END;  (* IF nogui *)
  825.   ELSE
  826.     Request (ADR("Error: Out of memory"),NIL);
  827.   END;  (* IF chain # NIL *)
  828. CLOSE
  829.   IF geladen THEN
  830.     gtx.GTX_FreeWindows (chain, mt.Projects); geladen:=FALSE;
  831.   END;
  832.   IF chain # NIL THEN nf.FreeMemoryChain (chain,TRUE); chain:=NIL; END;
  833.   IF RD    # NIL THEN d.FreeArgs(RD); RD:=NIL; END;
  834.   IF fdef  # NIL THEN d.Close (fdef); fdef := NIL; END;
  835.   IF file  # NIL THEN d.Close (file); file := NIL; END;
  836. END ModGen.
  837.